COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	The following conversions are allowed with TYP
C00008 ENDMK
C⊗;
The following conversions are allowed with TYP
            [I] ↔ [K]
            [J] ↔ [L]
            [B,C] → [J,L]               (for Pascal ORD)
            [I,J,K,L] ↔ [S]
The following conversions are allowed with CVT
        [I,J,K,L] ↔ [Q,R]
        [I] ↔ [J]
        [K] ↔ [L]
        [Q] ↔ [R]
        [I,J,K,L] → [C]   

 UTYP, UTYP2 :

    begin
    if OPC = UTYP then STE := TOP else STE := TOP-1;
    with STK[STE] do
    if DTYPE <> TYPO2 then ERROR(WINSTR_TYPE_NOT_DATUM_TYPE);
    if IS_SINGLE[TYPO2] and IS_SINGLE[TYP] then
	begin
	if IS_INTEGER[TYPO2] and TYP in [TYPUJ, TYPUL, TYPUS] then DTYPE := TYP
	else if TYPO2 = TYPUB and IS_INTEGER[TYP] then
	    begin
	    if BREPRES = BJUMP then  BJUMP_TO_BINTVAL (STE);
	    DTYPE := TYP
	    end
	else if TYPO2 in [TYPUC, TYPUS] and IS_INTEGER[TYP] then DTYPE := TYP
	else ERROR
        end 
    else if IS_DOUBLE[TYPO2] and IS_DOUBLE[TYP] then
	begin
	if IS_INTEGER[TYPO2] and TYP in [TYPUI, TYPUK, TYPUS] then DTYPE := TYP
	else if TYPO2 = TYPUS and IS_INTEGER[TYP] then DTYPE := TYP
	else ERROR
	end
    else ERROR
    end (*UTYP,UTYP2*)

 UCVT, UCVT2 :

    begin
    if OPC = UCVT then STE := TOP else STE := TOP-1;
    COERCE_DATUM(STE, TYP);
    end;



UORD :
    with STK[TOP] do
	begin
	if not (DTYPE in [TYPUJ,TYPUI,TYPUB,TYPUC]) then
	    ERROR (WORD_NEEDS_INT_BOOLEAN_OR_CHAR);

	if DTYPE in [TYPUB, TYPUC] then
	    begin
	    if (DTYPE=TYPUB) and (BREPRES=BJUMP) then
		BJUMP_TO_BINTVAL (TOP);
	    DTYPE := TYPQ;
	    end;
	end ;



UCHR :
    with STK[TOP] do
	if not IS_INTEGER[DTYPE] then
	    ERROR (WCHR_NEEDS_INT)
	else
	    begin
	    COERCE_DATUM (TOP, TYPQ);
	    DTYPE := TYPUC;
	    end ;




procedure COERCE_DATUM(STE :  STKINX; RTYPE :  OPNDTYPE);
    (*Perform an implicit type coercion of the datum STE to type RTYPE*)

    var OPND, OPNDR :  OPERAND;
	MOVEOP : S1OPCODE;

    begin
    with STK[STE] do
	if DTYPE <> RTYPE then
	    begin
	    MOVEOP := MOV_X_Y[RTYPE,DTYPE];
	    if MOVEOP = XILLEGAL then
		ERROR(WINVALID_IMPLICIT_TYPE_COERCION);
	    if IS_CONSTANT(STE) then
		if (DTYPE = TYPUN) and (RTYPE = TYPUA) then
		    (*leave TYPUN alone, it's already TYPUA (sort of)*)
		else
		    DTYPE := RTYPE
	    else if DTYPE = TYPUM then
		begin
		if not ( RTYPE = TYPUA) then ASSERTFAIL('COERCE_DA001');
		repeat SIMPLIFY(STE) until DTYPE = TYPUA;
		end
	    else
		begin
		GET_OPERAND(OPND,STE);	FREEDATUMREGS(STE);
		if IS_DOUBLE[RTYPE] then FINDRP else FINDRG;
		REG_OPERAND(OPNDR,NXTRG);
		EMITXOP(MOVEOP,OPNDR,OPND);
		REG_DATUM(STE,CODESTART,RTYPE,NXTRG)
		end
	    end
    end (*COERCE_DATUM*);


procedure COERCE_TWO_DATUMS(var IS_OKTYPE :
					 OPNDTYPE_TO_BOOLEAN_ARRAY);
	    (*Instead of IS_OKTYPE, could possibly pass a set
	     of legal result types.*)
    (*Take the top two datums on the stack, verify that they represent
     acceptable types, and emit code to coerce them both to the same
     result type.*)

    var TYPE1, TYPE2, RTYPE :  OPNDTYPE;

    begin
    TYPE1 := STK[TOP-1].DTYPE;
    TYPE2 := STK[TOP].DTYPE;
    if not IS_OKTYPE[TYPE1] or not IS_OKTYPE[TYPE2] then
	ERROR(WBINARY_OPND_TYPE_CONFLICT);
    RTYPE := ARITH_RESULT_TYPE[TYPE1,TYPE2];
    if RTYPE = ILLARITH then
	ERROR (WBINARY_OPND_TYPE_CONFLICT);
    COERCE_DATUM(TOP-1,RTYPE);
    COERCE_DATUM(TOP,RTYPE)
    end (*COERCE_TWO_DATUMS*);